home *** CD-ROM | disk | FTP | other *** search
/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / modvbcamera.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-16  |  9.3 KB  |  404 lines
  1. Attribute VB_Name = "modVbCamera"
  2. '******************************************************************'
  3. '*                                                                *'
  4. '*                      TurboCAD for Windows                      *'
  5. '*                   Copyright (c) 1993 - 2001                    *'
  6. '*             International Microcomputer Software, Inc.         *'
  7. '*                            (IMSI)                              *'
  8. '*                      All rights reserved.                      *'
  9. '*                                                                *'
  10. '******************************************************************'
  11.  
  12. Option Explicit
  13.  
  14. Public Sub Camera_Plan(TheView As View)
  15.     If (TheView.SpaceMode = imsiPaperSpace) Then
  16.         MsgBox "Camera's properties can be changed only in model space"
  17.         Exit Sub
  18.         'Camera's properties can be changed only in model space
  19.     End If
  20.     Dim Cam1 As XCamera
  21.     Dim Vpos As XVertex
  22.     Dim VLookAt As Vertex
  23.     Dim VerUp As Vertex
  24.  
  25.     Set Cam1 = TheView.Camera
  26.     Set Vpos = New XVertex
  27.     Set VLookAt = Vpos.Duplicate
  28.     Set VerUp = Vpos.Duplicate
  29.     
  30.     Vpos.X = 0
  31.     Vpos.Y = 0
  32.     Vpos.Z = 1
  33.     
  34.     VLookAt.X = 0
  35.     VLookAt.Y = 0
  36.     VLookAt.Z = 0
  37.     
  38.     VerUp.X = 0
  39.     VerUp.Y = 1
  40.     VerUp.Z = 0
  41.     Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
  42.     TheView.Refresh
  43.     TheView.ZoomToExtents
  44.     TheView.Update = False
  45.     
  46.     Set VerUp = Nothing
  47.     Set Vpos = Nothing
  48.     Set VLookAt = Nothing
  49.     Set Cam1 = Nothing
  50. End Sub
  51.  
  52. Public Sub Camera_Right(TheView As View)
  53.     If (TheView.SpaceMode = imsiPaperSpace) Then
  54.         MsgBox "Camera's properties can be changed only in model space"
  55.         Exit Sub
  56.         'Camera's properties can be changed only in model space
  57.     End If
  58.     Dim Cam1 As XCamera
  59.     Dim Vpos As XVertex
  60.     Dim VLookAt As Vertex
  61.     Dim VerUp As Vertex
  62.     
  63.     Set Cam1 = TheView.Camera
  64.     Set Vpos = New XVertex
  65.     Set VLookAt = Vpos.Duplicate
  66.     Set VerUp = Vpos.Duplicate
  67.     
  68.     Vpos.X = 1
  69.     Vpos.Y = 0
  70.     Vpos.Z = 0
  71.     
  72.     VLookAt.X = 0
  73.     VLookAt.Y = 0
  74.     VLookAt.Z = 0
  75.     
  76.     VerUp.X = 0
  77.     VerUp.Y = 0
  78.     VerUp.Z = 1
  79.     
  80.     Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
  81.     TheView.ZoomToExtents
  82.     TheView.Refresh
  83.     
  84.     Set VerUp = Nothing
  85.     Set Vpos = Nothing
  86.     Set VLookAt = Nothing
  87.     Set Cam1 = Nothing
  88. End Sub
  89.  
  90.  
  91. Public Sub Camera_Left(TheView As View)
  92.     If (TheView.SpaceMode = imsiPaperSpace) Then
  93.         MsgBox "Camera's properties can be changed only in model space"
  94.         Exit Sub
  95.         'Camera's properties can be changed only in model space
  96.     End If
  97.     Dim Cam1 As XCamera
  98.     Dim Vpos As XVertex
  99.     Dim VLookAt As Vertex
  100.     Dim VerUp As Vertex
  101.     
  102.     Set Cam1 = TheView.Camera
  103.     Set Vpos = New XVertex
  104.     Set VLookAt = Vpos.Duplicate
  105.     Set VerUp = Vpos.Duplicate
  106.     
  107.     Vpos.X = -1
  108.     Vpos.Y = 0
  109.     Vpos.Z = 0
  110.     
  111.     VLookAt.X = 0
  112.     VLookAt.Y = 0
  113.     VLookAt.Z = 0
  114.     
  115.     VerUp.X = 0
  116.     VerUp.Y = 0
  117.     VerUp.Z = 1
  118.     
  119.     Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
  120.     TheView.ZoomToExtents
  121.     TheView.Refresh
  122.     
  123.     Set VerUp = Nothing
  124.     Set Vpos = Nothing
  125.     Set VLookAt = Nothing
  126.     Set Cam1 = Nothing
  127. End Sub
  128.  
  129. Public Sub Camera_Front(TheView As View)
  130.   If (TheView.SpaceMode = imsiPaperSpace) Then
  131.         MsgBox "Camera's properties can be changed only in model space"
  132.         Exit Sub
  133.         'Camera's properties can be changed only in model space
  134.   End If
  135.     Dim Cam1 As XCamera
  136.     Dim Vpos As XVertex
  137.     Dim VLookAt As Vertex
  138.     Dim VerUp As Vertex
  139.     
  140.     Set Cam1 = TheView.Camera
  141.     Set Vpos = New XVertex
  142.     Set VLookAt = Vpos.Duplicate
  143.     Set VerUp = Vpos.Duplicate
  144.     
  145.     Vpos.X = 0
  146.     Vpos.Y = -1
  147.     Vpos.Z = 0
  148.     
  149.     VLookAt.X = 0
  150.     VLookAt.Y = 0
  151.     VLookAt.Z = 0
  152.     
  153.     VerUp.X = 0
  154.     VerUp.Y = 0
  155.     VerUp.Z = 1
  156.     
  157.     Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
  158.     TheView.ZoomToExtents
  159.     TheView.Refresh
  160.     
  161. Set VerUp = Nothing
  162. Set Vpos = Nothing
  163. Set VLookAt = Nothing
  164. Set Cam1 = Nothing
  165.  
  166. End Sub
  167.  
  168.  
  169. Public Sub Camera_Back(TheView As View)
  170.   If (TheView.SpaceMode = imsiPaperSpace) Then
  171.         MsgBox "Camera's properties can be changed only in model space"
  172.         Exit Sub
  173.         'Camera's properties can be changed only in model space
  174.   End If
  175.     Dim Cam1 As XCamera
  176.     Dim Vpos As XVertex
  177.     Dim VLookAt As Vertex
  178.     Dim VerUp As Vertex
  179.     
  180.     Set Cam1 = TheView.Camera
  181.     Set Vpos = New XVertex
  182.     Set VLookAt = Vpos.Duplicate
  183.     Set VerUp = Vpos.Duplicate
  184.     
  185.     Vpos.X = 0
  186.     Vpos.Y = 1
  187.     Vpos.Z = 0
  188.     
  189.     VLookAt.X = 0
  190.     VLookAt.Y = 0
  191.     VLookAt.Z = 0
  192.     
  193.     VerUp.X = 0
  194.     VerUp.Y = 0
  195.     VerUp.Z = 1
  196.     
  197.     Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
  198.     TheView.ZoomToExtents
  199.     TheView.Refresh
  200.     
  201. Set VerUp = Nothing
  202. Set Vpos = Nothing
  203. Set VLookAt = Nothing
  204. Set Cam1 = Nothing
  205.  
  206. End Sub
  207.  
  208. Public Sub Camera_Bottom(TheView)
  209.   If (TheView.SpaceMode = imsiPaperSpace) Then
  210.         MsgBox "Camera's properties can be changed only in model space"
  211.         Exit Sub
  212.         'Camera's properties can be changed only in model space
  213.   End If
  214.     Dim Cam1 As XCamera
  215.     Dim Vpos As XVertex
  216.     Dim VLookAt As Vertex
  217.     Dim VerUp As Vertex
  218.     
  219.     Set Cam1 = TheView.Camera
  220.     Set Vpos = New XVertex
  221.     Set VLookAt = Vpos.Duplicate
  222.     Set VerUp = Vpos.Duplicate
  223.     
  224.     Vpos.X = 0
  225.     Vpos.Y = 0
  226.     Vpos.Z = 1 '-1
  227.     
  228.     VLookAt.X = 0
  229.     VLookAt.Y = 0
  230.     VLookAt.Z = 0
  231.     
  232.     VerUp.X = 0
  233.     VerUp.Y = -1 '1
  234.     VerUp.Z = 0
  235.     
  236.     Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
  237.     TheView.ZoomToExtents
  238.     TheView.Refresh
  239.     
  240. Set VerUp = Nothing
  241. Set Vpos = Nothing
  242. Set VLookAt = Nothing
  243. Set Cam1 = Nothing
  244.  
  245. End Sub
  246. Public Sub Camera_ISO_SE(TheView As View)
  247.   If (TheView.SpaceMode = imsiPaperSpace) Then
  248.         MsgBox "Camera's properties can be changed only in model space"
  249.         Exit Sub
  250.         'Camera's properties can be changed only in model space
  251.   End If
  252.     Dim Cam1 As XCamera
  253.     Dim Vpos As XVertex
  254.     Dim VLookAt As Vertex
  255.     Dim VerUp As Vertex
  256.     
  257.     Set Cam1 = TheView.Camera
  258.     Set Vpos = New XVertex
  259.     Set VLookAt = Vpos.Duplicate
  260.     Set VerUp = Vpos.Duplicate
  261.     
  262.     Vpos.X = 1
  263.     Vpos.Y = -1
  264.     Vpos.Z = 1
  265.     
  266.     VLookAt.X = 0
  267.     VLookAt.Y = 0
  268.     VLookAt.Z = 0
  269.     
  270.     VerUp.X = 0
  271.     VerUp.Y = 0
  272.     VerUp.Z = 1
  273.     
  274.     Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
  275.     TheView.ZoomToExtents
  276.     TheView.Refresh
  277.     
  278. Set VerUp = Nothing
  279. Set Vpos = Nothing
  280. Set VLookAt = Nothing
  281. Set Cam1 = Nothing
  282.  
  283. End Sub
  284.  
  285. Public Sub Camera_ISO_NE(TheView As View)
  286.   If (TheView.SpaceMode = imsiPaperSpace) Then
  287.         MsgBox "Camera's properties can be changed only in model space"
  288.         Exit Sub
  289.         'Camera's properties can be changed only in model space
  290.   End If
  291.     Dim Cam1 As XCamera
  292.     Dim Vpos As XVertex
  293.     Dim VLookAt As Vertex
  294.     Dim VerUp As Vertex
  295.     
  296.     Set Cam1 = TheView.Camera
  297.     Set Vpos = New XVertex
  298.     Set VLookAt = Vpos.Duplicate
  299.     Set VerUp = Vpos.Duplicate
  300.     
  301.     Vpos.X = 1
  302.     Vpos.Y = 1
  303.     Vpos.Z = 1
  304.     
  305.     VLookAt.X = 0
  306.     VLookAt.Y = 0
  307.     VLookAt.Z = 0
  308.     
  309.     VerUp.X = 0
  310.     VerUp.Y = 0
  311.     VerUp.Z = 1
  312.     
  313.     Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
  314.     TheView.ZoomToExtents
  315.     TheView.Refresh
  316.     
  317. Set VerUp = Nothing
  318. Set Vpos = Nothing
  319. Set VLookAt = Nothing
  320. Set Cam1 = Nothing
  321.  
  322. End Sub
  323.  
  324.  
  325. Public Sub Camera_ISO_SW(TheView As View)
  326.   If (TheView.SpaceMode = imsiPaperSpace) Then
  327.         MsgBox "Camera's properties can be changed only in model space"
  328.         Exit Sub
  329.         'Camera's properties can be changed only in model space
  330.   End If
  331.     Dim Cam1 As XCamera
  332.     Dim Vpos As XVertex
  333.     Dim VLookAt As Vertex
  334.     Dim VerUp As Vertex
  335.     
  336.     Set Cam1 = TheView.Camera
  337.     Set Vpos = New XVertex
  338.     Set VLookAt = Vpos.Duplicate
  339.     Set VerUp = Vpos.Duplicate
  340.     
  341.     Vpos.X = -1
  342.     Vpos.Y = -1
  343.     Vpos.Z = 1
  344.     
  345.     VLookAt.X = 0
  346.     VLookAt.Y = 0
  347.     VLookAt.Z = 0
  348.     
  349.     VerUp.X = 0
  350.     VerUp.Y = 0
  351.     VerUp.Z = 1
  352.     
  353.     Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
  354.     TheView.ZoomToExtents
  355.     TheView.Refresh
  356.     
  357. Set VerUp = Nothing
  358. Set Vpos = Nothing
  359. Set VLookAt = Nothing
  360. Set Cam1 = Nothing
  361.  
  362. End Sub
  363.  
  364.  
  365. Public Sub Camera_ISO_NW(TheView As View)
  366.   If (TheView.SpaceMode = imsiPaperSpace) Then
  367.         MsgBox "Camera's properties can be changed only in model space"
  368.         Exit Sub
  369.         'Camera's properties can be changed only in model space
  370.   End If
  371.     Dim Cam1 As XCamera
  372.     Dim Vpos As XVertex
  373.     Dim VLookAt As Vertex
  374.     Dim VerUp As Vertex
  375.     
  376.     Set Cam1 = TheView.Camera
  377.     
  378.     Set Vpos = New XVertex
  379.     Set VLookAt = Vpos.Duplicate
  380.     Set VerUp = Vpos.Duplicate
  381.     
  382.     Vpos.X = -1
  383.     Vpos.Y = 1
  384.     Vpos.Z = 1
  385.     
  386.     VLookAt.X = 0
  387.     VLookAt.Y = 0
  388.     VLookAt.Z = 0
  389.     
  390.     VerUp.X = 0
  391.     VerUp.Y = 0
  392.     VerUp.Z = 1
  393.     
  394.     Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
  395.     TheView.ZoomToExtents
  396.     TheView.Refresh
  397.     
  398. Set VerUp = Nothing
  399. Set Vpos = Nothing
  400. Set VLookAt = Nothing
  401. Set Cam1 = Nothing
  402. End Sub
  403.  
  404.